Developer CD Series 1994 August: Tool Chest/Dev.CD Aug 94.toast/Sample Code/Newton Sample Code 1.1/Communications/Slurp-3/Slurp.text

Text File | 1994-03-08 | 20.1 KB | 688 lines | [TEXT/MPS ]

// © Copyright 1993-94 Apple Computer, Inc, All Rights Reserved

constant kAppSymbol := '|Slurp:PIEDTS|;
constant kPackageName := '|Slurp:PIEDTS|;
constant kAppObject := '["soup","soups"];

constant kSoupName := kPackageName;
constant kSoupIndexes := '[/* {structure: slot, path: name.first, type: string} */];


func zGetSound(name, file)
begin;
   local rf := OpenResFileX(file);
   local snd := {sndFrameType: 'simpleSound,
     samples: GetSndAsSamples(name),
     samplingRate: 22026.43172,
     dataType: 1,
     compressionType: 0};
   CloseResFileX(rf);
   return snd;
end;

func zGetSound11(name, file)
begin;
   local rf := OpenResFileX(file);
   local snd := {sndFrameType: 'simpleSound,
     samples: GetSndAsSamplesRate11KHz(name),
     samplingRate: 11013.21586,
     dataType: 1,
     compressionType: 0};
   CloseResFileX(rf);
   return snd;
end;

homeDir := "Beeld:Desktop Folder:New Slurp:";

theSlurpSound := zGetSound11("Slurping", "Slurping");

// ---- End Project Data ----


// ---- File SlurpBaseView.t ----
slurpBaseView :=
   {newEntry: nil,
    viewSetupDoneScript:
      func()
      begin
         :newStatus("Click Receive..., the send file from Mac...");

         self.commEndPt := { _proto:   protoSerialProtocol,
                             _parent:  self,
                             slurpBaseView:  self};

         PlaySound(slurpSound);
      end,
    epDisconnect:
      func()
      begin
      //   RemoveSlot(commEndPt, 'slurpBaseView);

         commEndPt:Abort();

         commEndPt:Release();
      end,
    viewQuitScript:
      func()
      begin
      //in your viewQuitScript, call
      //   :UnRegisterCardSoup(kSoupName);

         if StrEqual(receiveBtn.text, "Disconnect") then begin
            RemoveSlot(commEndPt, 'slurpBaseView);
            :epDisconnect();
         end;

         inherited:?viewQuitScript();
      end,
    RegisterCardSoup:
      func(soupName,soupIndexes,appSymbol,appObject)
        //returns a union-soup for your app to use
        begin
          //first check for system provided function
          if functions.RegisterCardSoup then
            return RegisterCardSoup(soupName,soupIndexes,appSymbol,appObject);

          CreateAppSoup(soupName,soupIndexes,EnsureInternal([appSymbol]),EnsureInternal(appObject));

          //ensure your soup will exist on stores which later become available
          AddArraySlot(CardSoups,soupName);
          AddArraySlot(CardSoups,soupIndexes);

          //ensure your soup exists on all currently available stores
          local store;
          foreach store in GetStores() do
            if NOT store:IsReadOnly() AND NOT store:HasSoup(soupName) then
              store:CreateSoup(soupName,soupIndexes);

          GetUnionSoup(soupName);
        end,
    entrySpec: nil,
    addNewEntry:
      /* addNewEntry
            Add a new entry into the soup.

          Slots used:
         entryIndex,entryString
         newEntry,entrySpec
         testSoup
         testSoupName


          Methods used:
              n/a

          Assumptions:
              none
      */
      func(s)
      begin
         // Setup the input buffer.  Our inputScripts give us
         // a line at a time.
         entryIndex := 0;
         entryString := s;

      //   :newStatus("addNewEntry: before currentEntryDisplay");
         currentEntryDisplay:newMsg(s);
      //   :newStatus("addNewEntry: after currentEntryDisplay");

         // Now initialize the new entry by cloning the
         // entry specification we got earlier.  This is
         // a frame with the same slots as a soup entry,
         // with sample slot values that are used to
         // specify the desired type for the data.
         newEntry := Clone(entrySpec);
         newEntry := :buildEntry(newEntry);
      //   :newStatus("addNewEntry: after buildEntry");

         // Fix the sortOn slot in the entry.
         // The sortOn slot contains a reference to the string in
         // either the names.last slot or the company slot.
         // This allows the Names app to keep a single index
         // on the sortOn slot, while still sorting by
         // either the names.last or company slotc values...
         if newEntry.sortOn = 'name then
            newEntry.sortOn := SetClass(newEntry.name.last, 'name);
         else
            newEntry.sortOn := SetClass(newEntry.company, 'company);

         // Now, assuming we have an entry, add it to
         // the default storage device.
         targetSoup:AddToDefaultStore(newEntry);
      //   :newStatus("addNewEntry: after AddToDefaultStore");

         // Flush our changes...
         targetSoup:Flush();
      //   :newStatus("addNewEntry: after targetSoup");

         // Tell the rest of the world that something has
         // changed.
         BroadcastSoupChange(targetSoupName);
      //   :newStatus("addNewEntry: after BroadcastSoupChange");

         numEntries := numEntries + 1;
         SetValue(entriesSlurped, 'text, "" & numEntries);

      //   :newStatus("addNewEntry: after addNewEntry");
      end,
    targetSoup: nil,
    newSoupName:
      func(s)
      begin
        :newStatus("Setting new soup name...");
         self.targetSoupName := SubStr(s, 0, StrPos(s, "\n", 0));
         self.targetSoup := GetUnionSoup(targetSoupName);
         SetValue(soupNameDisplay, 'text, targetSoupName);
         :newStatus("Waiting for entrySpec...");
      end,
    viewBounds: {left: -2, top: 2, right: 227, bottom: 239},
    _proto: protoApp,
    epInit:
      func()
      begin
         local   epErr := nil;

         commEndPt := { _proto:   protoSerialProtocol,
                        _parent:  self,
                        slurpBaseView:  self};

         :newStatus("Instantiating endpoint...");
         epErr := commEndPt:Instantiate(commEndPt, nil);

         Perform(epState, 'showState, ["After Instantiate:"]);

         if epErr then
         begin
            :newStatus("Instantiate Error:" && NumberStr(epErr));
            return;
         end;
         else
            :newStatus("Instantiating endpoint...done.");

         :newStatus("Ready to connect...");

         numEntries := 0;
      end,
    protoSerialProtocol:
      {
         _proto: protoEndpoint,         // the basic endpoint

         configOptions: [
            { label: kCMSAsyncSerial, type: 'service, opCode: opSetRequired },
            { label: kCMOSerialIOParms, type: 'option, opCode: opSetNegotiate,
               data: { bps: k9600bps, dataBits: k8DataBits, stopBits: k1StopBits, parity: kNoParity } },
            { label: kCMOInputFlowControlParms, type: 'option, opCode: opSetNegotiate,
               data: { xonChar: unicodeDC1, xoffChar: unicodeDC3, useSoftFlowControl: true, useHardFlowControl: nil } },
            ],

         exceptionHandler: func(exception)
         begin
            Perform(endpoint.slurpBaseView, 'newStatus, ["exceptionHandler called..."]);
         end,

         waitForSoupName:
         {
            InputForm: 'string,
            endCharacter: UnicodeCR,

            InputScript: func(endpoint, s)
            begin
               Perform(endpoint.slurpBaseView, 'newSoupName, [s]);
               endpoint:SetInputSpec(endpoint.waitForEntrySpec);
            end,
            discardAfter: 1000,
         },

         waitForEntrySpec:
         {
            InputForm: 'string,
            endCharacter: UnicodeCR,

            InputScript: func(endpoint, s)
            begin
               Perform(endpoint.slurpBaseView, 'buildEntrySpec, [s]);
               endpoint:SetInputSpec(endpoint.waitForEntries);
            end,
            discardAfter: 1000,
         },

         waitForEntries:
         {
            InputForm: 'string,
            endCharacter: UnicodeCR,
            InputScript: func(endpoint, s)
            begin
               if BeginsWith(s, "BYE!") then
               begin
                  Perform(endpoint.slurpBaseView, 'epDisconnect, []);
                  SetValue(endpoint.slurpBaseView.receiveBtn, 'text, "Receive...");
                  Perform(endpoint.slurpBaseView, 'newStatus, ["Slurp complete - Tap Receive... to Slurp another..."]);
               end;
               else
               begin
                  Perform(endpoint.slurpBaseView, 'addNewEntry, [s]);
                  endpoint:SetInputSpec(endpoint.waitForEntries);
               end;
            end,
            discardAfter: 1000,
         }
      },
    nextInputString:
      func()
      begin
         local sPos, s;

         sPos := StrPos(entryString, "\t", entryIndex);
         if not sPos then
            sPos := StrPos(entryString, "\n", entryIndex);

         s := SubStr(entryString, entryIndex, sPos - entryIndex);
         entryIndex := sPos + 1;
         s;
      end,
    entryString: "Text",
    title: "Slurp",
    commEndPt: nil,
    entrySpecFunc:
      func()
      begin
      end,
    buildEntrySpec:
      /* BuildEntrySpec
          Compile a WallyScript frame definition and get the resulting object.

          Slots used:
              entrySpec, entrySpecFunc

          Methods used:
              n/a

          Assumptions:

      */
      func(s)
      begin
         :newStatus("BuildEntrySpec: before Compile");
         entrySpecFunc := Compile(s);
         :newStatus("BuildEntrySpec: before entrySpecFunc()");
         entrySpec := :entrySpecFunc();
         :newStatus("BuildEntrySpec: after entrySpecFunc()");
      end,
    epConnect:
      func()
      begin
         local   epErr := nil;

         :newStatus("Connecting...");
         epErr := commEndPt:Connect(nil, nil);
         Perform(epState, 'showState, ["After Connect:"]);
         if epErr then
            :newStatus("Error trying to connect:" && NumberStr(epErr));
         else begin
            :newStatus("Connecting...done.");
            :newStatus("Setting input spec...");
            commEndPt:SetInputSpec(commEndPt.waitForSoupName);
            Perform(epState, 'showState, ["After SetInputSpec:"]);
            :newStatus("Setting input spec...done.");
            :newStatus("Waiting for soup name...");
         end;
      end,
    epDeferredDisconnect:
      func()
      begin
         commEndPt:Abort();

         commEndPt:Release();

      //   commEndPt:Dispose();
      end,
    newStatus:
      func(msg)
      begin
         statusBox:newMsg(msg);
         RefreshViews();
      end,
    slurpSound: theSlurpSound,
    entryIndex: nil,
    numEntries: nil,
    debug: "slurpBaseView",
    buildEntry:
      /* BuildEntry
          Convert a tab delimited string of data into a soup entry (ie. frame)

          Slots used:
              n/a

          Methods used:
              matchTypes, nextInputString

          Assumptions:
              currentFrameOrArray parameter is initialized to a frame.
      */
      func(currentFrameOrArray)
      begin
          // For each slot in the frame or each element in the array.
          // The cool thing about foreach is that it doesn't care.  By
          // using the path foreach creates, we can even assign values
          // with the exact same code...
          foreach path, value in currentFrameOrArray do begin
              // Get the real class of the first slot/element.  In the
              // case of the "Names" soup, the frame containing the
              // person's name has a class slot set to 'person.  Because
              // of this, the ClassOf function returns 'person instead
              // of 'frame.  Using PrimClassOf (ie. Prim(itive)ClassOf)
              // we can find out the real type.
              local pClass := PrimClassOf(value);

              // Since frames/arrays can contain other frames/arrays,
              // we can use recursion to simplify the function.  If
              // we run across an element that is a frame/array, we
              // just call ourself with the new path.  We Clone the
              // spec value to reduce garbage collection and prevent
              // having seperate code for creating frames and arrays.
              if pClass = 'frame or pClass = 'array then begin
                  currentFrameOrArray.(path) := Clone(value);
                  :BuildEntry(currentFrameOrArray.(path));
              end; else

              // Finally the real work.  If the slot value is not a
              // frame/array, assign the new value.  getNextField
              // returns the next tab-delimited string from the input
              // buffer.  matchTypes is used to coerce the string
              // into the type specified by value.
              // NOTE
              //    We pass value instead of ClassOf(value) because
              //    some types are specified using the contents of
              //    a string.  See matchTypes for more info...
                  currentFrameOrArray.(path) := :matchTypes(:nextInputString(), value);
       end;
       currentFrameOrArray;
      end,
    matchTypes:
      /* matchTypes
          Coerce the type of a value to match another.

          Slots used:
              n/a

          Methods used:
              n/a

          Assumptions:
         The type specified by valueType is never Frame or Array.
         If the type is string, then the real type is specified
         as a symbol stored within that string.  For example,
            "string"   Coerce the value to type string
            "date"     Coerce the value into a date value
         If the string is specified as:
            "stringWithClass"
         then the valueString is made into a symbol, and the
         type of the string becomes that symbol (ie. name, company).

      */
      func(valueString, valueType)
      begin
         local theType := ClassOf(valueType);

         // If valueType is string, get real type from string contents.
         if theType = 'string then
            theType := MakeSymbol(valueType);

      //   :newStatus("matchTypes:" && valueString && theType);

         if theType = 'string then
            valueString;
         else
         if theType = 'int then
            RintToL(StringToNumber(valueString));
         else
         if theType = 'real then
            StringToNumber(valueString);
         else
         if theType = 'symbol then
            MakeSymbol(valueString);
         else
         if theType = 'date then
            StringToDate(valueString);
         else
         // Special, extra-strange stuff for handling the Names soup.
         // Other soups may not require this code...
         if theType = 'stringWithClass then
            MakeSymbol(valueString);
         else begin
            if StrLen(valueString) > 0 then
               SetClass(valueString, theType);
         end;
      end,
    targetSoupName: nil,
    UnRegisterCardSoup:
      func(soupName)
        begin
          //first check for system provided function
          if functions.UnRegisterCardSoup then
            return UnRegisterCardSoup(soupName);

          local pos := ArrayPos(CardSoups,soupName,0,func(x,y) ClassOf(y)='String AND StrEqual(x,y));
          if pos then ArrayRemoveCount(CardSoups,pos,2);
        end
   };

statusBoxLabel := /* child of slurpBaseView */
   {text: "Slurp Status:",
    viewBounds: {left: 79, top: 18, right: 149, bottom: 34},
    viewFont: simpleFont9+tsBold,
    viewJustify: 8388610,
    _proto: protoStaticText,
    debug: "statusBoxLabel"
   };



receiveBtn := /* child of slurpBaseView */
   {text: "Receive...",
    buttonClickScript:
      func()
      begin
         numEntries := 0;
         if StrEqual(self.text, "Receive...") then
         begin
            Perform(self._parent, 'epInit, []);

            Perform(self._parent, 'epConnect, []);

            SetValue(self, 'text, "Disconnect");
         end;
         else
         begin
            Perform(self._parent, 'epDisconnect, []);
            SetValue(self, 'text, "Receive...");
         end;
      //   PlaySound(slurpSound);
      end,
    viewBounds: {left: 52, top: 164, right: 184, bottom: 179},
    _proto: protoTextButton,
    debug: "receiveBtn"
   };
// View receiveBtn is declared to slurpBaseView




// ---- File protoVT42 ----
protoVT42 :=
   {viewFlags: 67108923,
    viewFormat: 337,
    newmsg:
      func(msg)
      begin
         if lastChat then
            while Ticks() - lastChat < 10 do begin
               // Nothing...
            end;
         else
            lastChat := Ticks();

         SetValue(self.term, 'text, msg);
         SetValue(self.term, 'viewBounds, viewBounds);

         RefreshViews();
      end,
    lastChat: nil,
    viewclass: 77,
    debug: "protoVT42"
   };

term := /* child of protoVT42 */
   {viewFlags: 67108923,
    viewFormat: 257,
    viewlinespacing: 13,
    viewFont: simpleFont9,
    viewSetupFormScript:
      func()
      begin
         inherited:?viewSetupFormScript();
         self.viewBounds := Clone(viewBounds);
         viewBounds.right := viewBounds.right - viewBounds.left - 2;
         viewBounds.left := 2;
         viewBounds.bottom := viewBounds.bottom - viewBounds.top - 2;
         viewBounds.top := 2;
      end,
    viewclass: 81,
    debug: "term"
   };
// View term is declared to protoVT42




// ---- Back in File SlurpBaseView.t ----
statusBox := /* child of slurpBaseView */
   {viewBounds: {left: 12, top: 33, right: 225, bottom: 62},
    _proto: protoVT42,
    debug: "statusBox"
   };
// View statusBox is declared to slurpBaseView



epStateLabel := /* child of slurpBaseView */
   {text: "Connection State:",
    viewBounds: {left: 63, top: 185, right: 170, bottom: 199},
    viewClickScript:
      func(unit)
      begin
         epState:showState("Current state:");
      end,
    viewFlags: 515,
    viewFont: simpleFont9+tsBold,
    viewJustify: 8388610,
    _proto: protoStaticText,
    debug: "epStateLabel"
   };
// View epStateLabel is declared to slurpBaseView



epState := /* child of slurpBaseView */
   {viewBounds: {left: 15, top: 199, right: 216, bottom: 216},
    lastShowTime: nil,
    showState:
      func(msg)
      begin
         local theState := commEndPt:State();

         if theState then begin
            if lastShowTime then
               while Ticks() - lastShowTime < 10 do begin
                  // Nothing...
               end;

            :newMsg(msg && stateLabels[theState]);
            RefreshViews();

            lastShowTime := Ticks();
         end;
      end,
    stateLabels:
      [ "Uninitialized",
                              "Unbound",
                              "Idle",
                              "Out Conn Pending",
                              "In Conn Pending",
                              "Data Transfer",
                              "Out Release Pending",
                              "In Release Pending",
                              "In Flux"],
    _proto: protoVT42,
    debug: "epState"
   };
// View epState is declared to slurpBaseView



_view000 := /* child of slurpBaseView */
   {text: "Soup:",
    viewBounds: {left: 11, top: 66, right: 43, bottom: 81},
    _proto: protoStaticText
   };



soupNameDisplay := /* child of slurpBaseView */
   {text: "",
    viewBounds: {left: 42, top: 67, right: 99, bottom: 81},
    viewFont: simpleFont9,
    viewFormat: 337,
    _proto: protoStaticText,
    debug: "soupNameDisplay"
   };
// View soupNameDisplay is declared to slurpBaseView



_view001 := /* child of slurpBaseView */
   {text: "Entries Slurped:",
    viewBounds: {left: 99, top: 66, right: 189, bottom: 82},
    viewJustify: 8388610,
    _proto: protoStaticText
   };



entriesSlurped := /* child of slurpBaseView */
   {text: "0",
    viewBounds: {left: 187, top: 67, right: 226, bottom: 81},
    viewFont: simpleFont9,
    viewFormat: 337,
    viewJustify: 8388610,
    _proto: protoStaticText,
    debug: "entriesSlurped"
   };
// View entriesSlurped is declared to slurpBaseView



_view002 := /* child of slurpBaseView */
   {text: "Current Entry:",
    viewBounds: {left: 76, top: 82, right: 157, bottom: 97},
    _proto: protoStaticText
   };



currentEntryDisplay := /* child of slurpBaseView */
   {viewBounds: {left: 12, top: 97, right: 222, bottom: 155},
    _proto: protoVT42,
    debug: "currentEntryDisplay"
   };
// View currentEntryDisplay is declared to slurpBaseView







// ---- Beginning of section for non used Layout files ----

// End of output